perm filename CYCLIC[DEN,LMM] blob
sn#070829 filedate 1973-11-11 generic text, type T, neo UTF8
(FILECREATED "11-NOV-73 09:25:52" S-CYCLIC
changes to: MAXREST,LPROWS,NEWNODES,NEWNODES1,FVPART1,TRIMZEROS,
LOOPPARTITIONS1,LOOPPARTITIONS,TRIM,MAXLOOPS,GRAPHON,CYCLICVARS
previous date: " 8-NOV-73 14:36:23")
(LISPXPRINT (QUOTE CYCLICVARS)
T)
(RPAQQ CYCLICVARS
((* Unfortunately, this file is a catch-all for
not-easy-to-classify files)
(FNS VALENCE FVPARTITION1 FVPART1 MINLOOPS MAXLOOPS
SUPERATOMPARTITIONS MAXUNSATL COMPUTEFV ROWS
BIVALENTPARTITIONS TRIMZEROS TD LOOPPARTITIONS1 NEWNODES
NEWNODES1 LPROWS CLPARTLP1 NUMPARTITIONS NUMPARTITIONS'
FVPARTITIONS EVENP LOOPPARTITIONS MAXREST CLBYVALENCE
TRIM GRAPHON)
(RECORDS SUPERATOMPARTITION FVPARTITION LOOPPARTITION)
(PROP VALENCE C H O N CH CH2 CH3 W OH CHOH COH Y #)))
(* Unfortunately, this file is a catch-all for not-easy-to-classify
files)
(DEFINEQ
(VALENCE
[LAMBDA (X)
(PROG (TEM)
[SETQ TEM (COND
((NULL X)
2)
((NUMBERP X)
X)
((ATOM X)
(GETP X (QUOTE VALENCE)))
(T (FREEVALENCESIZE X]
[COND
((NOT (AND (NUMBERP TEM)
(IGREATERP TEM 0)))
(SETQ TEM (HELP "WHAT IS VALENCE OF" X))
(AND (LITATOM X)
(/PUT X (QUOTE VALENCE)
TEM]
(RETURN TEM])
(FVPARTITION1
[LAMBDA (N VL S)
(* Partition N into as many parts as length VL;
with the Ith part having at most VL:I*
(S+I) -
Then partition the ith part according to FVPART1)
(COND
((NULL VL)
(LIST NIL))
(T (FOR I FROM [MAX 0 (IDIFFERENCE N (TD (CDR VL)
(ADD1 S]
TO (MIN N (ITIMES (CAR VL)
S))
AS PARTREST IS (FVPARTITION1 (IDIFFERENCE N I)
(CDR VL)
(ADD1 S))
FOR FIRSTPART
IN (FVPART1 I (CAR VL)
S)
FOR RESTPART
IN PARTREST XLIST (CONS FIRSTPART RESTPART])
(FVPART1
[LAMBDA (N MAXSUM MAXOCCUR)
(* Partition N into parts of the form MAXOCCUR * I1
, MAXOCCUR-1 * I2 , MAXOCCUR-2 * I3 ...
where the SUM of the I's is less than or equal to
MAXSUM)
(* WARNING: value may be
RPLAC'ed)
(COND
((ZEROP MAXOCCUR)
(LIST NIL))
((ZEROP N)
(LIST (FOR I FROM 1 TO MAXOCCUR COLLECT 0)))
(T (FOR I FROM [MAX 0 (IDIFFERENCE N (ITIMES MAXSUM (SUB1
MAXOCCUR]
TO (MIN MAXSUM (IQUOTIENT N MAXOCCUR)) FOR REST
IN (FVPART1 (IDIFFERENCE N (ITIMES I MAXOCCUR))
(IDIFFERENCE MAXSUM I)
(SUB1 MAXOCCUR))
XLIST
(CONS I REST])
(MINLOOPS
[LAMBDA (VALENCELIST)
(SETQ VALENCELIST (TRIMZEROS VALENCELIST))
(MAX 0 (IDIFFERENCE (ADD1 (LENGTH VALENCELIST))
(IQUOTIENT (TD (CDR VALENCELIST)
3)
2])
(MAXLOOPS
[LAMBDA (VALENCELIST)
(MIN (CAR VALENCELIST)
(MAXREST (CDDR VALENCELIST)
4])
(SUPERATOMPARTITIONS
[LAMBDA (CL U)
(PROG (CL1 SZ MXUI VI)
(SETQ CL1 (for PR in CL when (EQ (VALENCE (CAR PR))
1)
collect PR))
(SETQ CL (CLDIFF CL CL1))
(SETQ SZ (CLCOUNT CL))
(FOR PARTSIZE FROM 2 TO SZ FOR VHAT IN (CLPARTS CL PARTSIZE)
AS REMATS IS (APPEND CL1 (CLDIFF CL VHAT)) FOR #PARTS
FROM 1
TO (IQUOTIENT PARTSIZE 2) FOR PARTITION
IN (CLPARTITIONSN VHAT #PARTS 2)
AS VI IS (CLCREATE PARTITION)
AS MXUI IS (MAXUNSATL VI (COND
((AND (NULL REMATS)
(NULL (CDR PARTITION)))
U)))
FOR UI
IN (NUMPARTITIONS' U 1 MXUI (collect CDR in VI))
XLIST
(create SUPERATOMPARTITION SUPERATOMPARTS←(CLCREATE
(collect (CONS Y X) for X
in (CLEXPAND VI)
as Y
in UI))
REMAININGATOMS← REMATS])
(MAXUNSATL
[LAMBDA (PC U)
(* Note U is either NIL (normal) or it is equal to
the unsaturation in the case where remats is NIL and
there is only one part here)
(FOR
PARTNUM IN PC
COLLECT
(PROG (N TD M)
(SETQ N (SETQ TD (SETQ M 0)))
[for PR in (CAR PARTNUM)
do (SETQ N (IPLUS N (CDR PR)))
[SETQ TD (IPLUS TD (ITIMES (CDR PR)
(VALENCE (CAR PR]
(SETQ M (MAX M (VALENCE (CAR PR]
(SETQ N (IDIFFERENCE (IPLUS 2 TD)
(ITIMES 2 N)))
(RETURN
(IQUOTIENT [IPLUS N
(MIN (COND
((AND U (EQ (ITIMES U 2)
N))
0)
(T -1))
(IDIFFERENCE TD (ITIMES 2 M]
2])
(COMPUTEFV
[LAMBDA (U CL)
(IDIFFERENCE [IPLUS 2 (for PR in CL
sum (ITIMES (VALENCE (CAR PR))
(CDR PR]
(ITIMES 2 (IPLUS (CLCOUNT CL)
U])
(ROWS
[LAMBDA (LL)
(COND
((NULL LL)
(QUOTE (NIL)))
(T (CONS (CARLIST LL)
(ROWS (CDRLIST (CDR LL])
(BIVALENTPARTITIONS
[LAMBDA (VL) (* Number of parts LE
number of bivalents and
number of edges)
(FOR I FROM 1 TO (MIN (CAR VL)
(IQUOTIENT (TD (CDR VL)
3)
2))
JOIN (NUMPARTITIONS (CAR VL)
I 1 NIL])
(TRIMZEROS
[LAMBDA (L)
(* Returns NIL if L is all zeros , and the tail of L
which is not all zeros otherwise)
(PROG ((TRIMVAL 0))
(TRIM L])
(TD
[LAMBDA (VL J)
(for I from J as X in VL sum (ITIMES I X])
(LOOPPARTITIONS1
[LAMBDA (P VL J)
(* P is a number of loops; VL is a valencelist
starting with J-valents; returns the partitions of
number of loops among these nodes -
a partition is of the form
(j-valentpart j+1-valentpart ...) where each part is
(number of single loops, number of double loops,
...))
(COND
((NULL VL)
(LIST NIL))
(T
(* PJ is the number of loops allocated to J-valents;
MAXREST is the max number of loops that can go on
the rest)
(FOR PJ FROM [MAX 0 (IDIFFERENCE P (MAXREST (CDR VL)
(ADD1 J]
TO (MIN P (ITIMES (SUB1 (IQUOTIENT J 2))
(CAR VL)))
AS RESTL IS (LOOPPARTITIONS1 (IDIFFERENCE P PJ)
(CDR VL)
(ADD1 J))
FOR THISPART1
IN (FVPART1 PJ (CAR VL)
(SUB1 (IQUOTIENT J 2)))
AS THISPART IS (TRIMZEROS (DREVERSE THISPART1))
FOR RESTPART
IN RESTL XLIST (CONS THISPART RESTPART])
(NEWNODES
[LAMBDA (LPP)
(* LPP is a list: LPP:i-2 is a list for the old
i+VALENCE nodes of the (number of single loops,
number of double loops, ...); this function returns
(number of VALENCE+2 nodes getting 1 loop, number of
VALENCE+4 nodes getting 2 loops, ...))
(NEWNODES1 LPP 1])
(NEWNODES1
[LAMBDA (LPP J)
(COND
((NULL LPP)
NIL)
(T (PROG [(TEM (NEWNODES1 (CDDR LPP)
(ADD1 J)))
(TEM2 (CAR (NTH (CAR LPP)
J]
(COND
((AND (NULL TEM)
(OR (NULL TEM2)
(ZEROP TEM2)))
NIL)
(T (CONS (OR TEM2 0)
TEM])
(LPROWS
[LAMBDA (LPP VL)
(* VL is a valencelist starting with bivalents -
LPP is an output from LOOPPARTITIONS1: LPP:i+2
corresponds to VL:i, and is the list
(number of single loops, number of double loops, ...
for the i-valent nodes))
[SETQ VL (CONS (CAR VL)
(CONS (CADR VL)
(FOR V2 IN (CDDR VL) AS LOOPLST IN LPP
COLLECT (IDIFFERENCE V2 (SUMOF LOOPLST]
(* This VL is now the
valence list with the
looped nodes removed)
(FOR V IN VL COLLECT (CONS V (NEWNODES (PROG1 LPP (SETQ LPP
(CDR LPP])
(CLPARTLP1
[LAMBDA (CL ROW N)
(COND
((NULL ROW)
(LIST NIL))
((ZEROP (CAR ROW))
(CLPARTLP1 CL (CDR ROW)
(ADD1 N)))
(T (FOR EP IN (CLPARTS CL (ITIMES N (CAR ROW)))
AS RPL IS (CLPARTLP1 (CLDIFF CL EP)
(CDR ROW)
(ADD1 N))
FOR EEP
IN (CLEQUALPARTS EP (CAR ROW)
N)
FOR RP
IN RPL XLIST (APPEND (CLCREATE EEP)
RP])
(NUMPARTITIONS
[LAMBDA (N NUMPARTS MINPART MAXPART) (* NEW FEATURE: MAXPART
NIL MEANS MAXPART
INFINITY)
(COND
[(EQ NUMPARTS 1)
(COND
((OR (IGREATERP MINPART N)
(AND MAXPART (ILESSP MAXPART N)))
NIL)
(T (LIST (LIST N]
(T (FOR I FROM (COND
[MAXPART (MAX MINPART
(IDIFFERENCE N
(ITIMES (SUB1
NUMPARTS)
MAXPART]
(T MINPART))
TO (COND
(MAXPART (MIN MAXPART (IQUOTIENT N NUMPARTS)))
(T (IQUOTIENT N NUMPARTS)))
FOR RESTPART
IN (NUMPARTITIONS (IDIFFERENCE N I)
(SUB1 NUMPARTS)
I MAXPART)
XLIST
(CONS I RESTPART])
(NUMPARTITIONS'
[LAMBDA (U MN MAXIMA OCCURLIST)
(COND
((NULL (CDR OCCURLIST))
(NUMPARTITIONS U (CAR OCCURLIST)
MN
(CAR MAXIMA)))
(T (FOR FIRSTPART
FROM [MAX MN (IDIFFERENCE
(IDIFFERENCE (CIELING U)
(ITIMES (SUB1 (CAR OCCURLIST))
(CAR MAXIMA)))
(sum (ITIMES X Y) for X in (CDR MAXIMA)
as Y
in (CDR OCCURLIST]
TO (MIN (CAR MAXIMA)
(IQUOTIENT (IDIFFERENCE U (SUMOF (CDR OCCURLIST)))
(CAR OCCURLIST)))
FOR RESTPART
IN [COND
((EQ (CAR OCCURLIST)
1)
(NUMPARTITIONS' (IDIFFERENCE U FIRSTPART)
1
(CDR MAXIMA)
(CDR OCCURLIST)))
(T (NUMPARTITIONS' (IDIFFERENCE U FIRSTPART)
FIRSTPART MAXIMA
(CONS (SUB1 (CAR OCCURLIST))
(CDR OCCURLIST]
XLIST
(CONS FIRSTPART RESTPART])
(FVPARTITIONS
[LAMBDA (FV VL)
(FOR FVP IN (FVPARTITION1 FV (CDR VL)
1)
AS FVR IS (ROWS FVP)
COLLECT (create FVPARTITION NEWVL←(collect
(IDIFFERENCE (IPLUS V (SUMOF ROW))
(SUMOF COL))
for ROW
in FVR
as COL
in (CONS NIL FVP)
as V
in VL)
FVR← FVR])
(EVENP
[LAMBDA (X)
(ZEROP (IREMAINDER X 2])
(LOOPPARTITIONS
[LAMBDA (P VL)
(* Returns a list of lists of LOOPPARTITIONs, sorted
by NEWVL, for P loops among the valence list VL;
a LOOPPARTITION consists of a NEWVL
(new valence list), EDGELABELS
(a composition list of number-of-bivalents), and
LOOPLABELS (a composition list of loop-types, where
a loop-type is a composition list of
number-of-bivalents). For example, the looplabels:
((((5 . 2) (3 . 2)) . 1) (((1 . 2)) . 3)) means that
1 node gets two loops with 5 bivalents and two loops
with 3; and that three nodes get two loops with 1
bivalent (e.g. O=X=O))
(* LOOPPARTITIONS1 determines where the loops will
go; ROWS is a list ROWS:2 ROWS:3 ROWS:4 ...
, where ROWS:i is a list: ((number of i valent nodes
with no loops) (number of i valent nodes getting 1
loop) (number of i valent nodes getting 2 loops)
...) where the valence refers to the valence in the
NEW graph)
(FOR LPP IN (LOOPPARTITIONS1 P (CDDR VL)
4)
AS ROWS IS (LPROWS LPP VL)
AS NEWVL IS (CONS (SUMOF (CDAR ROWS))
(MAPCAR (CDR ROWS)
(FUNCTION SUMOF)))
WHEN (GRAPHON (TRIMZEROS NEWVL))
XLIST
(FOR K FROM 0 TO (MIN (IDIFFERENCE (CAR VL)
P)
(IQUOTIENT (TD NEWVL 2)
2))
FOR BP
IN (NUMPARTITIONS (CAR VL)
(IPLUS P K)
1 NIL)
AS CLBP IS (CLCREATE BP) FOR EL
IN (CLPARTS CLBP K) FOR LPL
IN [CLPARTITIONSL (CLDIFF CLBP EL)
(PROG (TRIMVAL)
(TRIM (CDRLIST ROWS]
XLIST
(create LOOPPARTITION LOOPVL← NEWVL EDGELABELS← EL
LOOPLABELS← LPL])
(MAXREST
[LAMBDA (VL J)
(* VL is a valencelist starting at J-valents -
returns the maximum number of loops that can be put
on nodes with VL as valence list)
(FOR OLD J FROM J TO 4 DO (SETQ VL (CDR VL)))
(FOR OLD VL ON VL AS OLD J FROM J
SUM (ITIMES (CAR VL)
(SUB1 (IQUOTIENT J 2])
(CLBYVALENCE
[LAMBDA (CL)
(SETQ CL (GROUPBY [FUNCTION (LAMBDA (PR)
(VALENCE (CAR PR]
CL))
(FOR I FROM 2 TO (FOR X IN CL MAXIMUM (CAR X))
COLLECT (CDR (ASSOC I CL])
(TRIM
[LAMBDA (LST)
(AND (LISTP LST)
(COND
((TRIM (CDR LST))
LST)
((EQ (CAR LST)
TRIMVAL)
NIL)
(T (RPLACD LST NIL)
LST])
(GRAPHON
[LAMBDA (VL)
(AND (EVENP (TD VL 2))
(ILESSP (LENGTH (TRIMZEROS VL))
(IDIFFERENCE (IQUOTIENT (TD VL 2)
2)
(SUMOF VL])
)
(RECORD SUPERATOMPARTITION (SUPERATOMPARTS . REMAININGATOMS))
(RECORD FVPARTITION (NEWVL . FVR))
(RECORD LOOPPARTITION (LOOPVL EDGELABELS . LOOPLABELS))
(DEFLIST(QUOTE(
(C 4)
(H 1)
(O 2)
(N 3)
(CH 3)
(CH2 2)
(CH3 1)
(W 2)
(OH 1)
(CHOH 2)
(COH 3)
(Y 3)
(# 2)
))(QUOTE VALENCE))
STOP